home *** CD-ROM | disk | FTP | other *** search
/ Enter 2004 January / enter-2004-01.iso / files / maxima-5.9.0.exe / {app} / share / maxima / 5.9.0 / src / flatten.lisp < prev    next >
Encoding:
Text File  |  2003-02-09  |  2.9 KB  |  99 lines
  1. ;; Flatten 
  2. ;; Barton Willis
  3. ;; University of Nebraska at Kearney (aka UNK)
  4. ;;    1 Nov 2002
  5.  
  6. ;; License: GPL
  7. ;; The user of this code assumes all risk for its use. It has no warranty.
  8. ;; If you don't know the meaning of "no warranty," don't use this code. :)
  9.  
  10. ;; Installation and usage:  Put flatten.lisp in a directory that
  11. ;; Maxima can find.  (Maxima can find files in directories described
  12. ;; in the list file_search_lisp.) To use flatten, begin by loading it.
  13.  
  14. ;; (C1) load("flatten.lisp")$
  15. ;; (C2) flatten([x=7,[y+x=0,z+1=0], [[x-y=2]]]);
  16. ;; (D2)         [x = 7, y + x = 0, z + 1 = 0, x - y = 2]
  17. ;; (C3) m : matrix([a,b],[c,d])$
  18. ;; (C4) flatten(args(m));
  19. ;; (D4)         [a, b, c, d] 
  20.  
  21. ;; Flatten is somewhat difficult to define -- essentially it evaluates an 
  22. ;; expression as if its main operator had been declared nary; however, there 
  23. ;; is a difference.  We have
  24.  
  25. ;; (C1) load("flatten.lisp");
  26. ;; (D1)         flatten.lisp
  27. ;; (C2) flatten(f(g(f(f(x)))));
  28. ;; (D2)         f(g(f(f(x))))
  29. ;; (C3) declare(f,nary);
  30. ;; (D3)         DONE
  31. ;; (C4) ev(d2);
  32. ;; (D4)         f(g(f(x)))
  33. ;; (C5) 
  34.  
  35. ;; Unlike declaring the main operator of an expression to be nary, flatten 
  36. ;; doesn't recurse into other function arguments.  
  37.  
  38. ;; This is supposed to be a clone of Macsyma's flatten function.  
  39. ;; Unlike the Macyma version, this version
  40. ;;    (a) handles CRE expressions,
  41. ;;    (b) doesn't try to flatten expressions of the form a^(b^c) -- Macsyma's
  42. ;;        flatten gives an error about a "wrong number of arguments to "^"."
  43. ;;    (c) doesn't try to flatten expressions of the form a=(b=c).
  44.  
  45. ;; There are other functions other than ^ and = that we shouldn't try
  46. ;; to flatten -- Bessel functions, etc.  
  47.  
  48. (in-package "MAXIMA")
  49. ($put '$flatten 1 '$version)
  50.  
  51. ;; Return the operator and argument of the expression e.
  52.  
  53. (defun get-op-and-arg (e)
  54.   (let ((op) (arg))
  55.     (cond ((or ($atom e) ($subvarp e))
  56.        (setq op nil)
  57.        (setq arg nil))
  58.       ((and (consp (nth 0 e)) ($subvarp (nth 1 e)))
  59.        (setq op `(,(nth 0 e) ,(nth 1 e)))
  60.        (setq arg (cddr e)))
  61.       (t
  62.        (setq op (nth 0 e))
  63.        (setq arg (cdr e))))
  64.     (values op arg)))
  65.  
  66. (defun $flatten (e)
  67.   (setq e (ratdisrep e))
  68.   (cond ((or ($atom e) ($subvarp e)(or (member ($inpart e 0) (list '&^ '&=))))
  69.      e)
  70.     (t
  71.      (let ((op (multiple-value-list (get-op-and-arg e))))
  72.        (setq e (cadr op))
  73.        (setq op (car op))
  74.        (setq e (mapcar #'(lambda (x) (flatten-op x op)) e))
  75.        (setq e (reduce #'append e))
  76.        (cond ((and (consp (car op)) (eq (caar op) 'mqapply))
  77.           (append op e))
  78.          (t
  79.           `(,op ,@e)))))))
  80.       
  81. (defun flatten-op (e op)
  82.   (let ((e-op) (e-arg))
  83.     (setq e-op (multiple-value-list (get-op-and-arg e)))
  84.     (setq e-arg (cadr e-op))
  85.     (setq e-op (car e-op))
  86.     (cond ((equal e-op op)
  87.        (mapcan #'(lambda (x) (flatten-op x op)) e-arg))
  88.       (t
  89.        (list e)))))
  90.        
  91.        
  92.  
  93.  
  94.  
  95.  
  96.     
  97.  
  98.           
  99.